{$R-}
{$D+}
(*
	PanasonicTQ2024F -- a HyperCard user-defined command to drive a 
	Panasonic TQ-2024F write-once laserdisc player.
	©Apple Computer, Inc. 1987
	All Rights Reserved.


	To compile and link this file using Macintosh Programmer's Workshop
	(HyperXCmd.p and XCmdGlue.inc must be accessible).

	pascal -w PanasonicTQ2024F.p
	link -m ENTRYPOINT -o HyperCommands -rt XCMD=11 -sn Main=PanasonicTQ2024F ¶
	  PanasonicTQ2024F.p.o "{MPW}"Libraries:interface.o

    then use ResEdit to copy the resulting XCMD from HyperCommands
	and paste it into the Home stack, or your own stack.
	(XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000)
*)

{$S PanasonicTQ2024F } 	{ Segment name must be the same as the command name. }

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
	
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
	
IMPLEMENTATION

TYPE Str19 = String[19];
	 Str31 = String[31];

PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr);						FORWARD;

   PROCEDURE EntryPoint(paramPtr: XCmdPtr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     PanasonicTQ2024F(paramPtr);
   END;

   PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
	   tempStr: Str255;
	   refNum: INTEGER;
	   err: INTEGER;
       params: ARRAY[1..32] OF Str19;

     {$I XCmdGlue.inc }
	  
	 PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
	 BEGIN
	   paramPtr^.returnValue := PasToZero(errMsg);
	   EXIT(PanasonicTQ2024F);
	 END;
	 	   
	 PROCEDURE OpenSerial;
	 VAR handShake: SerShk;
		 baudRate: INTEGER;
	 BEGIN
	   baudRate := 9600;
	   { for now, use modem port so we don't mess with AppleTalk }
	   err := FSOpen('.AOUT',0,refNum);
	   IF err = 0 THEN 
	     BEGIN
		   WITH handShake DO
			 BEGIN
			   fXon := 1;
			   fCTS := 1;
			   xon  := CHR(17);
			   xoff := CHR(19);
			   errs := 0;
			   evts := 0;
			   fInx := 0;
			 END;
		   err := SerHShake(refNum,handShake);
		   IF err = 0 THEN 
			 err := Control(refNum,13,@baudRate);
		 END;
	 END;
	 
	 
	 PROCEDURE CloseSerial;
	 BEGIN
	   err := FSClose(refNum);
	 END;
	 
	 
	 PROCEDURE SendCommand(cmd: Str255);
	 VAR count: LongInt;
	 BEGIN
	   count := Length(cmd) + 2;
	   cmd[Length(cmd) + 1] := CHR(3);    { control-c }
	   cmd[0] := CHR(2);   				  { control-B }
	   { Is overwriting the length byte a dangerous thing? }
	   err := FSWrite(refNum, count, @cmd);
	 END;
	 
	 FUNCTION Concat(str1, str2, str3: Str255): Str255;
	 VAR result: Str255;
		 resultLen: INTEGER;
		 charNum: INTEGER;
	 BEGIN
	   result := '';
	   resultLen := 0;
	   FOR charNum := 1 TO Length(str1) DO
		 BEGIN
		   resultLen := resultLen + 1;
		   result[resultLen] := str1[charNum];
		 END;
	   FOR charNum := 1 TO Length(str2) DO
		 BEGIN
		   resultLen := resultLen + 1;
		   result[resultLen] := str2[charNum];
		 END;
	   FOR charNum := 1 TO Length(str3) DO
		 BEGIN
		   resultLen := resultLen + 1;
		   result[resultLen] := str3[charNum];
		 END;
	  result[0] := CHR(resultLen);
	  Concat := result;
	 END;
	 
	 
	 PROCEDURE GetMessage;	 
	 VAR paramNum, charNum: INTEGER;
		 msgChar: CHAR;
	 BEGIN
	   { convert params to pascal strings }
	   FOR paramNum := 1 TO paramPtr^.paramCount DO
		 BEGIN
		   tempStr := params[paramNum];
		   ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
		   { force all chars to lower case }
		   FOR charNum := 1 TO Length(tempStr) DO
			 BEGIN
			   msgChar := tempStr[charNum];
			   IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
				 tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
			 END;
		   params[paramNum] := tempStr;
		 END;
	 END;
	 
	   
	 FUNCTION Contains(target: Str255): BOOLEAN;
	 VAR offset: INTEGER;	 
	 
	   FUNCTION Match(which: INTEGER): BOOLEAN;
	   VAR index: INTEGER;
	   BEGIN
		 Match := TRUE;
		 FOR index := 1 TO Length(target) DO
		   IF index > Length(params[which]) THEN 
			 BEGIN
			   Match := FALSE;  { ran off the end }
			   EXIT(Match);
			 END
		   ELSE IF target[index] <> params[which][index] THEN
			 BEGIN
			   Match := FALSE;  { hit a wrong char }
			   EXIT(Match);
			 END;
	   END;
	   
	 BEGIN
	   Contains := FALSE;
	   FOR offset := 1 TO paramPtr^.paramCount DO
		 IF Match(offset) THEN
		   BEGIN
			 Contains := TRUE;
			 EXIT(Contains);
		   END;
	 END;
	   
  
	 FUNCTION GetInteger: Str255;
	 { get an integer in Pioneer format }
	 VAR which, digitLoc, charVal: INTEGER;
	 BEGIN
	   FOR which := 1 TO paramPtr^.paramCount DO
		 BEGIN
		   charVal := ORD(params[which][1]);
		   IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
		     BEGIN
	           GetInteger := params[which];		{that whole parameter}
		  	   exit(GetInteger);
			 END;
		 END;
	   GetInteger := '';	{ just in case }
	 END;

   BEGIN
	 OpenSerial;
	 IF err <> 0 THEN 
	   BEGIN
	     SysBeep(1);
	     Fail('Could not open serial port');
	   END;
	 
     GetMessage;
	 
	 { set flags }
	 reverseFlag := Contains('rev');
	 offFlag := Contains('off');
	 tillFlag := Contains('till');
	 
	 IF Contains('init') THEN SendCommand('AC;ON0:')
	 ELSE IF Contains('stop') THEN SendCommand('TF')
	 ELSE IF Contains('eject') THEN SendCommand('EJ')
	 ELSE IF Contains('search') THEN SendCommand(Concat('SR', GetInteger, ':'))
	 ELSE IF Contains('step') THEN
	   BEGIN
		 IF NOT reverseFlag THEN SendCommand('TF')		{step fwd}
	     ELSE SendCommand('TR')							{step rev}
	   END
	 ELSE IF Contains('play') THEN
	   BEGIN
		 IF NOT tillFlag THEN
		 	BEGIN
				IF NOT reverseFlag THEN SendCommand('PF')	{play fwd}
		 		ELSE SendCommand('PR'); 					{play rev}
			END
		 ELSE
		   BEGIN
				IF NOT reverseFlag 
				THEN SendCommand(Concat('PF', GetInteger, ':'))	 {play till fwd}
		 		ELSE SendCommand(Concat('PR', GetInteger, ':')); {play till rev}
		   END;
	   END
	 ELSE IF Contains('slower') THEN
	   BEGIN
	     IF tillFlag THEN
		   BEGIN
		     IF reverseFlag THEN SendCommand(Concat('LR32:', GetInteger, ':'))
			 ELSE SendCommand(Concat('LF32:', GetInteger, ':'));
		   END
		 ELSE IF reverseFlag THEN SendCommand('LR32:')
		   ELSE SendCommand('LF32:')
	   END
	 ELSE IF Contains('slowest') THEN
	   BEGIN
	     IF tillFlag THEN
		   BEGIN
		     IF reverseFlag THEN SendCommand(Concat('LR64:', GetInteger, ':'))
			 ELSE SendCommand(Concat('LF64:', GetInteger, ':'));
		   END
		 ELSE IF reverseFlag THEN SendCommand('LR64:')
		   ELSE SendCommand('LF64:')
	   END
	 ELSE IF Contains('slow') THEN
	  IF NOT tillFlag THEN
		BEGIN
		  IF NOT reverseFlag THEN SendCommand('LF16:')		{slow fwd}
		  ELSE SendCommand('LR16:')							{slow rev}
		END
	  ELSE
		BEGIN
		  IF NOT reverseFlag THEN SendCommand(Concat('LF16:', GetInteger, ':'))	{slow TILL fwd}
		  ELSE SendCommand(Concat('LR16:', GetInteger, ':'))				{slow TILL rev}
		END
	 ELSE IF Contains('faster') THEN
	   BEGIN
	     IF tillFlag THEN
		   BEGIN
		     IF reverseFlag THEN SendCommand(Concat('FR8:', GetInteger, ':'))
			 ELSE SendCommand(Concat('FF8:', GetInteger, ':'));
		   END
	     ELSE IF reverseFlag THEN SendCommand('FR8:')
		   ELSE SendCommand('FF8:')
	   END
	 ELSE IF Contains('fast') THEN
	  IF NOT tillFlag THEN
		BEGIN
		  IF NOT reverseFlag THEN SendCommand('FF3:')		{fast fwd}
		  ELSE SendCommand('FR3:')							{fast rev}
		END
	  ELSE
		BEGIN
		  IF NOT reverseFlag THEN SendCommand(Concat('FF3:', GetInteger, ':'))	{fast TILL fwd}
		  ELSE SendCommand(Concat('FR3:', GetInteger, ':'))				{fast TILL rev}
		END
	 ELSE IF Contains('scan') THEN
	   BEGIN
		 IF NOT reverseFlag THEN SendCommand('FF10:')			{scan fwd}
	     ELSE SendCommand('FR10:')								{scan rev}
	   END
	 ELSE IF Contains('picture') THEN
	   BEGIN
		 IF NOT offFlag THEN SendCommand('VS')				{picture on}
	     ELSE SendCommand('VR')								{picture off}
	   END
	 ELSE IF Contains('frame') THEN
	   BEGIN
		 IF NOT offFlag THEN SendCommand('DS')				{frame on}
	     ELSE SendCommand('DR')								{frame off}
	   END
	 ELSE IF Contains('sound') THEN 
	   BEGIN
	     IF Contains('1') THEN
		   IF NOT offFlag THEN SendCommand('A134:')			{sound 1 on}
		   ELSE SendCommand('A10:')							{sound 1 off}
		 ELSE IF Contains('2') THEN
		   IF NOT offFlag THEN SendCommand('A234:')			{sound 2 on}
		   ELSE SendCommand('A20:')							{sound 2 off}
		 ELSE
		   BEGIN
	         CloseSerial;
		     Fail('Unknown video sound channel');
		   END;
	   END
	 ELSE
	 	BEGIN
		  CloseSerial;
		  SysBeep(1); 
		  Fail('Unknown video command');
		END;
	 CloseSerial;
   END;   

END.



